home *** CD-ROM | disk | FTP | other *** search
- (*************************************************************************
-
- $RCSfile: OC.mod $
- Description: Main entry point for the Oberon-A compiler.
-
- Created by: fjc (Frank Copeland)
- $Revision: 5.14 $
- $Author: fjc $
- $Date: 1995/01/26 00:17:17 $
-
- Copyright © 1993-1995, Frank Copeland
- This module forms part of the OC program
- See OC.doc for conditions of use and distribution
-
- Log entries are at the end of the file.
-
- *************************************************************************)
-
- <* STANDARD- *>
-
- MODULE OC;
-
- IMPORT
-
- SYS := SYSTEM, Kernel, Errors, e := Exec, ti := Timer, u := Utility,
- d := Dos, du := DosUtil, Files, In, str := Strings, OCRev, OCStrings,
- OCM, OCS, OCT, OCC, OCE, Compiler, wb := Workbench, i := Icon;
-
- CONST
-
- CopyrightStr = "Copyright © 1993-95 Frank Copeland\n";
-
- VAR
-
- file, batchFile : Files.File;
- r : Files.Rider;
- tr : ti.TimeRequestPtr;
- returnError, returnWarn : BOOLEAN;
- startDir : d.FileLockPtr;
-
-
- (* -- Command line template and parsing ------------------------------- *)
-
- CONST
-
- template =
- "NS=NEWSYMFILE/S,BATCH/S,"
- "SETTINGS/K,SEARCH/K,"
- "SYMPATH/K,OBJPATH/K,ERRPATH/K,"
- "SYMEXT/K,OBJEXT/K,ERREXT/K,"
- "VERBOSE/S,DEBUG/S,MAKEICONS/S,"
- "QUIET/S,NODEBUG/S,NOICONS/S,"
- "SET/K,CLEAR/K,FILES/M,"
- (* These are temporary and will disappear eventually *)
- "FORCE/S,TEXTERR/S,TRACE/S";
-
- template2 = "FILES/M";
-
- optNS = 0;
- optBATCH = 1;
- optSETTINGS = 2;
- optSEARCH = 3;
- optSYMPATH = 4;
- optOBJPATH = 5;
- optERRPATH = 6;
- optSYMEXT = 7;
- optOBJEXT = 8;
- optERREXT = 9;
- optVERBOSE = 10;
- optDEBUG = 11;
- optMAKEICONS = 12;
- optQUIET = 13;
- optNODEBUG = 14;
- optNOICONS = 15;
- optSET = 16;
- optCLEAR = 17;
- optFILES = 18;
- optFORCE = 19;
- optTEXTERR = 20;
- optTRACE = 21;
- optCount = 22;
-
- helpStr =
- "\nSETTINGS/K -- preferences file\n"
- "NS=NEWSYMFILE/S -- generate a new symbol file if necessary\n"
- "BATCH/S -- batch compile\n"
- "SEARCH/K -- search directories for symbol files\n"
- "SYMPATH/K,OBJPATH/K,ERRPATH/K\n"
- " -- destinations for symbol, object and error files\n"
- "DEBUG/S|NODEBUG/S -- output symbol info for a debugger\n"
- "SET/K,CLEAR/K -- defaults for pragmas, options and selectors\n"
- "FILES/M -- source file(s)\n"
- "See OC.doc for more details\n\n"
- "Arguments ? ";
-
- TYPE
-
- StringArray = POINTER [2] TO ARRAY MAX(INTEGER) OF e.LSTRPTR;
-
- VAR
-
- rdArgs, rdArgs2 : d.RDArgsPtr;
- args : ARRAY optCount OF SYS.LONGWORD;
-
- (* These are filled in by ParseArgs() *)
-
- files : StringArray;
- newSymFile, batch : BOOLEAN;
-
- (*------------------------------------*)
- PROCEDURE* Cleanup (VAR rc : LONGINT);
-
- VAR oldDir : d.FileLockPtr;
-
- BEGIN (* Cleanup *)
- IF file # NIL THEN Files.Close (file); file := NIL END;
- IF batchFile # NIL THEN Files.Close (batchFile); batchFile := NIL END;
- IF ti.base # NIL THEN e.CloseDevice (tr); ti.base := NIL END;
- IF rdArgs # NIL THEN
- d.FreeArgs (rdArgs);
- d.FreeDosObject (d.rdArgs, rdArgs);
- rdArgs := NIL
- END;
- IF rdArgs2 # NIL THEN
- (* d.FreeArgs (rdArgs2); *)
- d.FreeDosObject (d.rdArgs, rdArgs2);
- rdArgs2 := NIL
- END;
- IF Kernel.fromWorkbench THEN oldDir := d.CurrentDir (startDir) END
- END Cleanup;
-
- (*------------------------------------*)
- PROCEDURE Init ();
-
- BEGIN (* Init *)
- Kernel.SetCleanup (Cleanup);
- returnError := FALSE; returnWarn := FALSE;
-
- NEW (tr);
- Errors.Assert
- ( e.OpenDevice (ti.timerName, ti.vBlank, tr, {}) = 0,
- "OC -- failed to open timer.device" );
- ti.base := tr.node.device;
-
- rdArgs := d.AllocDosObjectTags (d.rdArgs, u.end);
- rdArgs2 := d.AllocDosObjectTags (d.rdArgs, u.end);
- ASSERT ((rdArgs # NIL) & (rdArgs2 # NIL));
- rdArgs.extHelp := SYS.ADR (helpStr);
- END Init;
-
- (*------------------------------------*)
- PROCEDURE CloneStr ( oldStr : e.LSTRPTR ) : e.LSTRPTR;
- VAR newStr : e.LSTRPTR;
- BEGIN (* CloneStr *)
- SYS.NEW (newStr, str.Length (oldStr^) + 1);
- COPY (oldStr^, newStr^);
- RETURN newStr
- END CloneStr;
-
- (*------------------------------------*)
- PROCEDURE ParseArgs ();
-
- VAR
- string : e.LSTRPTR; strings : StringArray;
- i : INTEGER; ignore : BOOLEAN; ch : CHAR;
- args2 : ARRAY 1 OF SYS.LONGWORD;
- verbose, quiet, debug, nodebug, makeicons, noicons : BOOLEAN;
-
- (*------------------------------------*)
- PROCEDURE ParseString (s, msg : ARRAY OF CHAR);
-
- VAR len : LONGINT; buffer : e.LSTRPTR;
-
- <*$CopyArrays-*>
- BEGIN (* ParseString *)
- len := str.Length (s) + 2;
- SYS.NEW (buffer, len);
- COPY (s, buffer^);
- buffer [len-2] := "\n"; buffer [len-1] := 0X;
- rdArgs2.source.buffer := buffer;
- rdArgs2.source.length := len - 1;
- rdArgs2.source.curChr := 0;
- rdArgs2.daList := 0; rdArgs2.buffer := NIL; rdArgs2.bufSiz := 0;
- rdArgs2.extHelp := NIL; rdArgs2.flags := {};
- args2 [0] := NIL;
- IF d.OldReadArgs (template2, args2, rdArgs2) = NIL THEN
- ignore := d.PrintFault (d.IoErr(), msg);
- HALT (d.warn)
- END
- END ParseString;
-
- BEGIN (* ParseArgs *)
- newSymFile := (SYS.VAL (LONGINT, args [optNS]) # 0);
- batch := (SYS.VAL (LONGINT, args [optBATCH]) # 0);
-
- string := SYS.VAL (e.LSTRPTR, args [optSETTINGS]);
- IF string = NIL THEN
- ignore := OCM.LoadPrefs ("OC.prefs")
- ELSE
- IF ~OCM.LoadPrefs (string^) THEN
- OCM.OutStr1 (OCStrings.OC1, string^);
- HALT (d.warn)
- END
- END;
-
- string := SYS.VAL (e.LSTRPTR, args [optSEARCH]);
- IF string # NIL THEN
- OCM.ClearSearchPaths();
- ParseString (string^, " !! SYM");
- strings := SYS.VAL (StringArray, args2 [0]);
- IF strings # NIL THEN
- i := 0;
- WHILE strings [i] # NIL DO
- OCM.AddSearchPath (CloneStr (strings [i]));
- INC (i)
- END;
- END;
- d.FreeArgs (rdArgs2)
- END;
- OCM.AddSearchPath (SYS.ADR ("OLIB:"));
-
- string := SYS.VAL (e.LSTRPTR, args [optSYMPATH]);
- IF string # NIL THEN COPY (string^, OCM.SymPath) END;
- string := SYS.VAL (e.LSTRPTR, args [optOBJPATH]);
- IF string # NIL THEN COPY (string^, OCM.ObjPath) END;
- string := SYS.VAL (e.LSTRPTR, args [optERRPATH]);
- IF string # NIL THEN COPY (string^, OCM.ErrPath) END;
-
- string := SYS.VAL (e.LSTRPTR, args [optSYMEXT]);
- IF string # NIL THEN COPY (string^, OCM.SymExt) END;
- string := SYS.VAL (e.LSTRPTR, args [optOBJEXT]);
- IF string # NIL THEN COPY (string^, OCM.ObjExt) END;
- string := SYS.VAL (e.LSTRPTR, args [optERREXT]);
- IF string # NIL THEN COPY (string^, OCM.ErrExt) END;
-
- verbose := (SYS.VAL (LONGINT, args [optVERBOSE]) # 0);
- quiet := (SYS.VAL (LONGINT, args [optQUIET]) # 0);
- IF verbose & quiet THEN OCM.OutStr0 (OCStrings.OC14); HALT (d.warn)
- ELSIF verbose THEN OCM.Verbose := TRUE
- ELSIF quiet THEN OCM.Verbose := FALSE
- END;
-
- debug := (SYS.VAL (LONGINT, args [optDEBUG]) # 0);
- nodebug := (SYS.VAL (LONGINT, args [optNODEBUG]) # 0);
- IF debug & nodebug THEN OCM.OutStr0 (OCStrings.OC15); HALT (d.warn)
- ELSIF debug THEN OCM.Debug := TRUE
- ELSIF nodebug THEN OCM.Debug := FALSE
- END;
-
- makeicons := (SYS.VAL (LONGINT, args [optMAKEICONS]) # 0);
- noicons := (SYS.VAL (LONGINT, args [optNOICONS]) # 0);
- IF makeicons & noicons THEN OCM.OutStr0 (OCStrings.OC16); HALT (d.warn)
- ELSIF makeicons THEN OCM.MakeIcons := TRUE
- ELSIF noicons THEN OCM.MakeIcons := FALSE
- END;
-
- string := SYS.VAL (e.LSTRPTR, args [optSET]);
- IF (string = NIL) & (OCM.SetNames # "") THEN
- string := SYS.ADR (OCM.SetNames)
- END;
- IF string # NIL THEN
- ParseString (string^, " !! SET");
- strings := SYS.VAL (StringArray, args2 [0]);
- IF strings # NIL THEN
- i := 0;
- WHILE strings [i] # NIL DO
- OCS.Set (strings [i]^);
- INC (i)
- END;
- END;
- d.FreeArgs (rdArgs2)
- END;
-
- string := SYS.VAL (e.LSTRPTR, args [optCLEAR]);
- IF (string = NIL) & (OCM.ClearNames # "") THEN
- string := SYS.ADR (OCM.ClearNames)
- END;
- IF string # NIL THEN
- ParseString (string^, " !! CLEAR");
- strings := SYS.VAL (StringArray, args2 [0]);
- IF strings # NIL THEN
- i := 0;
- WHILE strings [i] # NIL DO
- OCS.Clear (strings [i]^);
- INC (i)
- END;
- END;
- d.FreeArgs (rdArgs2)
- END;
-
- files := SYS.VAL (StringArray, args [optFILES]);
-
- OCM.Force := (SYS.VAL (LONGINT, args [optFORCE]) # 0);
- OCS.binErrFile := (SYS.VAL (LONGINT, args [optTEXTERR]) = 0);
- IF SYS.VAL (LONGINT, args [optTRACE]) # 0 THEN OCM.StartTrace() END;
- END ParseArgs;
-
- (*------------------------------------*)
- PROCEDURE ReportTime (VAR t1, t2 : ti.TimeVal);
-
- PROCEDURE Pair ( ch : CHAR; x : LONGINT );
- BEGIN (* Pair *)
- OCM.OutChar (ch);
- OCM.OutChar (CHR (x DIV 10 + 30H));
- OCM.OutChar (CHR (x MOD 10 + 30H))
- END Pair;
-
- BEGIN (* ReportTime *)
- ti.SubTime (t2, t1);
- OCM.OutStr (" Elapsed time =");
- Pair (" ", t2.secs DIV 60);
- Pair (":", t2.secs MOD 60);
- OCM.OutChar ("."); OCM.OutInt (t2.micro DIV 100000);
- OCM.OutLn; OCM.OutLn
- END ReportTime;
-
- (*------------------------------------*)
- PROCEDURE Compile (source : ARRAY OF CHAR);
-
- VAR
- t1, t2 : ti.TimeVal;
-
- <*$CopyArrays-*>
- BEGIN (* Compile *)
- IF OCM.Verbose THEN ti.GetSysTime (t1) END;
-
- file := Files.Old (source);
- IF file = NIL THEN
- OCM.OutStr1 (OCStrings.OC6, source)
- ELSE
- OCM.OutStr1 (OCStrings.OC7, source);
- Compiler.newSF := newSymFile;
- Compiler.CompilationUnit (file);
- IF OCS.scanerr THEN returnError := TRUE
- ELSIF OCS.warned THEN returnWarn := TRUE
- END;
- Files.Close (file); file := NIL
- END;
-
- IF OCM.Verbose THEN
- ti.GetSysTime (t2);
- ReportTime (t1, t2)
- END
- END Compile;
-
- (*------------------------------------*)
- PROCEDURE Reset ();
-
- VAR
- t1, t2 : ti.TimeVal;
-
- BEGIN (* Reset *)
- IF OCM.Verbose THEN
- OCM.OutStr0 (OCStrings.OC8);
- ti.GetSysTime (t1);
- END;
-
- OCC.Close (); OCT.Close ();
- Kernel.GC;
-
- IF OCM.Verbose THEN
- ti.GetSysTime (t2);
- ReportTime (t1, t2)
- END;
- END Reset;
-
- (*------------------------------------*)
- PROCEDURE Interactive ();
-
- CONST prompt = "Source file ? : ";
-
- VAR nameBuffer : ARRAY 256 OF CHAR;
-
- BEGIN (* Interactive *)
- OCM.OutStr0 (OCStrings.OC9);
- In.Open; In.Name (nameBuffer);
- IF nameBuffer [0] # 0X THEN
- Compile (nameBuffer);
- LOOP
- OCM.OutStr0 (OCStrings.OC9);
- In.Open; In.Name (nameBuffer);
- IF nameBuffer = "" THEN EXIT END;
- Reset ();
- Compile (nameBuffer)
- END
- END
- END Interactive;
-
- (*------------------------------------*)
- PROCEDURE Batch (batchName : ARRAY OF CHAR);
-
- VAR
- sourceName : ARRAY 256 OF CHAR;
- i : INTEGER;
- ch : CHAR;
- t1, t2 : ti.TimeVal;
-
- <*$CopyArrays-*>
- BEGIN (* Batch *)
- batchFile := Files.Old (batchName);
- IF batchFile # NIL THEN
- IF OCM.Verbose THEN ti.GetSysTime (t1) END;
-
- Files.Set (r, batchFile, 0);
- LOOP
- Files.Read (r, ch);
- IF r.eof THEN EXIT END;
- WHILE ch <= " " DO (* Skip whitespace *)
- Files.Read (r, ch);
- IF r.eof THEN EXIT END
- END;
- i := 0;
- REPEAT
- sourceName [i] := ch; INC (i); Files.Read (r, ch)
- UNTIL r.eof OR (ch = "\n");
- sourceName [i] := 0X;
- Compile (sourceName);
- IF r.eof THEN EXIT END;
- Reset ()
- END;
- Files.Set (r, NIL, 0); Files.Close (batchFile); batchFile := NIL;
-
- IF OCM.Verbose THEN
- ti.GetSysTime (t2);
- OCM.OutStr0 (OCStrings.OC10);
- ReportTime (t1, t2)
- END;
- ELSE
- OCM.OutStr1 (OCStrings.OC11, batchName)
- END
- END Batch;
-
- (*------------------------------------*)
- PROCEDURE Main ();
-
- (*------------------------------------*)
- PROCEDURE WbArgs ();
-
- VAR
- wbStartup : wb.WBStartupPtr;
- oldDir : d.FileLockPtr;
- diskObj : wb.DiskObjectPtr;
- toolTypes : wb.ToolTypePtr;
- string : e.LSTRPTR;
- arg : INTEGER;
-
- BEGIN (* WbArgs *)
- ASSERT (i.base # NIL, 100);
-
- wbStartup := SYS.VAL (wb.WBStartupPtr, Kernel.WBenchMsg);
-
- (* Attempt to load the icon *)
- startDir := d.CurrentDir (wbStartup.argList[0].lock);
- diskObj := i.GetDiskObject (wbStartup.argList[0].name^);
- IF diskObj # NIL THEN
- toolTypes := diskObj.toolTypes;
- string := i.FindToolType (toolTypes, "NEWSYMFILE");
- IF string # NIL THEN args [optNS] := TRUE END;
- string := i.FindToolType (toolTypes, "BATCH");
- IF string # NIL THEN args [optBATCH] := TRUE END;
- string := i.FindToolType (toolTypes, "SETTINGS");
- IF string # NIL THEN args [optSETTINGS] := CloneStr (string) END;
- string := i.FindToolType (toolTypes, "SEARCH");
- IF string # NIL THEN args [optSEARCH] := CloneStr (string) END;
- string := i.FindToolType (toolTypes, "SYMPATH");
- IF string # NIL THEN args [optSYMPATH] := CloneStr (string) END;
- string := i.FindToolType (toolTypes, "OBJPATH");
- IF string # NIL THEN args [optOBJPATH] := CloneStr (string) END;
- string := i.FindToolType (toolTypes, "ERRPATH");
- IF string # NIL THEN args [optERRPATH] := CloneStr (string) END;
- string := i.FindToolType (toolTypes, "SYMEXT");
- IF string # NIL THEN args [optSYMEXT] := CloneStr (string) END;
- string := i.FindToolType (toolTypes, "OBJEXT");
- IF string # NIL THEN args [optOBJEXT] := CloneStr (string) END;
- string := i.FindToolType (toolTypes, "ERREXT");
- IF string # NIL THEN args [optERREXT] := CloneStr (string) END;
- string := i.FindToolType (toolTypes, "VERBOSE");
- IF string # NIL THEN args [optVERBOSE] := TRUE END;
- string := i.FindToolType (toolTypes, "QUIET");
- IF string # NIL THEN args [optQUIET] := TRUE END;
- string := i.FindToolType (toolTypes, "DEBUG");
- IF string # NIL THEN args [optDEBUG] := TRUE END;
- string := i.FindToolType (toolTypes, "NODEBUG");
- IF string # NIL THEN args [optNODEBUG] := TRUE END;
- string := i.FindToolType (toolTypes, "MAKEICONS");
- IF string # NIL THEN args [optMAKEICONS] := TRUE END;
- string := i.FindToolType (toolTypes, "NOICONS");
- IF string # NIL THEN args [optNOICONS] := TRUE END;
- string := i.FindToolType (toolTypes, "SET");
- IF string # NIL THEN args [optSET] := CloneStr (string) END;
- string := i.FindToolType (toolTypes, "CLEAR");
- IF string # NIL THEN args [optCLEAR] := CloneStr (string) END;
-
- string := i.FindToolType (toolTypes, "FORCE");
- IF string # NIL THEN args [optFORCE] := TRUE END;
- string := i.FindToolType (toolTypes, "TEXTERR");
- IF string # NIL THEN args [optTEXTERR] := TRUE END;
- string := i.FindToolType (toolTypes, "TRACE");
- IF string # NIL THEN args [optTRACE] := TRUE END;
-
- i.FreeDiskObject (diskObj)
- END;
- ParseArgs();
- IF wbStartup.numArgs = 1 THEN
- IF d.IsInteractive (d.Input()) THEN Interactive()
- ELSE Errors.Abort ("OC -- No source files specified")
- END
- ELSE
- FOR arg := 1 TO (wbStartup.numArgs - 1) DO
- oldDir := d.CurrentDir (wbStartup.argList [arg].lock);
- IF batch THEN Batch (wbStartup.argList [arg].name^)
- ELSE Compile (wbStartup.argList [arg].name^)
- END;
- END
- END
- END WbArgs;
-
- (*------------------------------------*)
- PROCEDURE CliArgs ();
- VAR ignore : BOOLEAN; i : INTEGER;
- BEGIN (* CliArgs *)
- IF d.OldReadArgs (template, args, rdArgs) = NIL THEN
- ignore := d.PrintFault (d.IoErr(), "ReadArgs");
- HALT (d.warn)
- END;
- ParseArgs();
- IF files = NIL THEN
- IF d.IsInteractive (d.Input()) THEN Interactive()
- ELSE Errors.Abort ("OC -- No source files specified")
- END
- ELSE
- i := 0;
- WHILE files [i] # NIL DO
- IF batch THEN Batch (files [i]^)
- ELSE Compile (files [i]^)
- END;
- INC (i)
- END;
- END;
- END CliArgs;
-
- BEGIN (* Main *)
- IF Kernel.fromWorkbench THEN WbArgs()
- ELSE CliArgs()
- END
- END Main;
-
- <*$ClearVars+*>
- BEGIN (* OC *)
- ASSERT (e.SysBase.libNode.version >= 37);
- Errors.Init;
-
- OCM.OutStr (OCRev.vString);
- OCM.OutStr (CopyrightStr);
- OCM.OutStr0 (OCStrings.OC13);
- OCM.OutLn;
-
- Init();
- Main();
-
- IF returnError THEN HALT (d.error)
- ELSIF returnWarn THEN HALT (d.warn)
- END
- END OC.
-
- (***************************************************************************
-
- $Log: OC.mod $
- Revision 5.14 1995/01/26 00:17:17 fjc
- - Release 1.5
-
- Revision 5.13 1995/01/16 10:38:22 fjc
- - Fixed bug where an attempt was made to Lock (NIL,...),
- causing an Enforcer hit.
-
- Revision 5.12 1995/01/09 14:03:26 fjc
- - Changed console output depending on OCM.Verbose.
- - Removed command line arguments for icon names.
- - Implemented Workbench arguments.
-
- Revision 5.11 1995/01/05 11:43:08 fjc
- - Changed Compiler.forceCode to OCM.Force.
- - Added QUIET, NODEBUG and NOICONS arguments, and fixed
- handling of VERBOSE, DEBUG and MAKEICONS.
-
- Revision 5.10 1995/01/03 21:31:56 fjc
- - Changed OCG to OCM.
- - Changed to use catalogs:
- - Uses OCM for console I/O instead of Out.
- - Gets text from OCStrings instead of hard-coding it.
- - Added support for preferences:
- - Added preferences settings to command-line template.
- - Added SETTINGS argument to load settings from a file.
-
- Revision 5.8 1994/12/16 17:49:00 fjc
- - Added command-line options to specify file extensions.
-
- Revision 5.7 1994/11/13 11:44:09 fjc
- - Fixed formatting of elapsed time reports.
-
- Revision 5.6 1994/10/23 16:37:22 fjc
- - Replaced StdIO with In and Out for console IO.
-
- Revision 5.5 1994/09/25 18:17:32 fjc
- - Changed CPOINTER declaration.
-
- Revision 5.4 1994/09/19 23:10:05 fjc
- - Re-implemented Amiga library calls
-
- Revision 5.3 1994/09/16 18:13:12 fjc
- - Now uses ReadArgs() to process arguments.
- - Added SET and CLEAR arguments.
-
- Revision 5.2 1994/09/15 10:46:34 fjc
- - Replaced switches with pragmas.
- - Used Kernel instead of SYSTEM.
- - No longer uses IntuiUtil.
-
- Revision 5.1 1994/09/03 19:29:08 fjc
- - Bumped version number
-
- ***************************************************************************)
-